package Carp::Source::Always;

use strict;
use warnings;
use Carp::Source;


our $VERSION = '0.04';


our %options;


sub import {
    my $class = shift;
    %options = @_;
}


sub _warn {
  if ($_[-1] =~ /\n$/s) {
    my $arg = pop @_;
    $arg =~ s/ at .*? line .*?\n$//s;
    push @_, $arg;
  }
  $Carp::Source::CarpLevel = 1;
  warn Carp::Source::longmess_heavy(join('', grep { defined } @_), %options);
}


sub _die {
  if ($_[-1] =~ /\n$/s) {
    my $arg = pop @_;
    $arg =~ s/ at .*? line .*?\n$//s;
    push @_, $arg;
  }
  $Carp::Source::CarpLevel = 1;
  die Carp::Source::longmess_heavy(join('', grep { defined } @_), %options);
}

my %OLD_SIG;

BEGIN {
  @OLD_SIG{qw(__DIE__ __WARN__)} = @SIG{qw(__DIE__ __WARN__)};
  $SIG{__DIE__} = \&_die;
  $SIG{__WARN__} = \&_warn;
}

END {
  no warnings 'uninitialized';
  @SIG{qw(__DIE__ __WARN__)} = @OLD_SIG{qw(__DIE__ __WARN__)};
}

1;
__END__

{% USE p = PodGenerated %}

=head1 NAME

Carp::Source::Always - Warns and dies with stack backtraces and source code context

=head1 SYNOPSIS

  use Carp::Source::Always;

makes every C<warn()> and C<die()> complains loudly, with source code context
like L<Carp::Source>, in the calling package and elsewhere. More often used on
the command line:

  perl -MCarp::Source::Always script.pl

=head1 DESCRIPTION

This module is meant as a debugging aid. It can be used to make a script
complain loudly with stack backtraces and source code context when
C<warn()>ing or C<die()>ing.

You can specify the same options as L<Carp::Source>'s C<source_cluck()> takes,
separated by commas. For example:

    perl -MCarp::Source::Always=lines,5,color,'yellow on_blue' script.pl

It does not work for one-liners because there is no file from which to load
source code.

This module does not play well with other modules which fusses around with
C<warn>, C<die>, C<$SIG{'__WARN__'}>, C<$SIG{'__DIE__'}>.

{% PROCESS standard_pod %}

=cut

